home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue33 / construc / BERT.DPR next >
Encoding:
Text File  |  1998-04-06  |  8.5 KB  |  272 lines
  1. program BERT;
  2. {$I-}
  3. {.$DEFINE DEBUG}
  4. {$APPTYPE CONSOLE}
  5. uses
  6.   DrBobCGI, IniFiles, DB, DBTables, SysUtils;
  7.  
  8. const
  9.   IniFile = '.\report.ini';
  10.  
  11.   procedure DataSetTable(DataSet: TDataSet; NewRec: Boolean);
  12.   { NEW RECORD - Actions: POST, CANCEL }
  13.   { BROWSE RECORD - Actions: FIRST, PREV, NEXT, LAST, INSERT, DELETE, REFRESH }
  14.   const
  15.     Int: Array[1..9] of Char = '123456789';
  16.   var
  17.     i,j,col,items: Integer;
  18.     option: ShortString;
  19.   begin
  20.     if NewRec then
  21.     begin
  22.       write('<INPUT TYPE=SUBMIT NAME=Action VALUE=Post>');
  23.       write('<INPUT TYPE=SUBMIT NAME=Action VALUE=Cancel>')
  24.     end
  25.     else
  26.     begin
  27.       write('<INPUT TYPE=SUBMIT NAME=Action VALUE=First>');
  28.       write('<INPUT TYPE=SUBMIT NAME=Action VALUE=Prev>');
  29.       write('<INPUT TYPE=SUBMIT NAME=Action VALUE=Next>');
  30.       write('<INPUT TYPE=SUBMIT NAME=Action VALUE=Last>');
  31.       writeln(' ');
  32.       writeln('<INPUT TYPE=SUBMIT NAME=Action VALUE=Insert>');
  33.       writeln('<INPUT TYPE=SUBMIT NAME=Action VALUE=Delete>');
  34.       writeln(' ');
  35.       writeln('<INPUT TYPE=SUBMIT NAME=Action VALUE=Find>');
  36.       writeln('<INPUT TYPE=SUBMIT NAME=Action VALUE=Query>');
  37.       writeln(' ');
  38.       writeln('<INPUT TYPE=SUBMIT NAME=Action VALUE=Refresh>');
  39.     end;
  40.     writeln('<INPUT TYPE=RESET VALUE=Reset>');
  41.     writeln('<P>');
  42.     with DataSet do
  43.     begin
  44.       if NewRec then
  45.         writeln('<INPUT TYPE=HIDDEN NAME="',Fields[0].FieldName,'" VALUE="-1">')
  46.       else
  47.         writeln('<INPUT TYPE=HIDDEN NAME="',Fields[0].FieldName,
  48.                                  '" VALUE="',Fields[0].AsString,'">');
  49.     {$IFDEF DEBUG}
  50.       writeln('<P>');
  51.       writeln('Debug Action: <INPUT TYPE=TEXT NAME=Action>');
  52.       writeln('<P>');
  53.     {$ENDIF}
  54.       writeln('<TABLE BGCOLOR=BBBBBB BORDER><TR>');
  55.       col := 0;
  56.       with TIniFile.Create(IniFile) do
  57.       try
  58.         for i:=1 to FieldCount-1 do { first field was hidden }
  59.         begin
  60.           if Fields[i].DataType = ftMemo then
  61.           begin
  62.             writeln('</TR><TR><TD COLSPAN=3>');
  63.             col := 3;
  64.           end
  65.           else
  66.           if Fields[i].Size > 99 then
  67.           begin
  68.             Inc(col,2);
  69.             if col > 3 then
  70.             begin
  71.               writeln('</TR><TR>');
  72.               col := 2
  73.             end;
  74.             write('<TD COLSPAN=2>')
  75.           end
  76.           else
  77.           begin
  78.             Inc(col);
  79.             if col > 3 then
  80.             begin
  81.               writeln('</TR><TR>');
  82.               col := 1
  83.             end;
  84.             write('<TD>')
  85.           end;
  86.           write('<B>',ReadString(Fields[i].FieldName,'Name',Fields[i].FieldName),'</B><BR>');
  87.           items := ReadInteger(Fields[i].FieldName,'Items',0);
  88.           if items = 0 then
  89.           begin
  90.             if Fields[i].DataType = ftMemo then
  91.             begin
  92.               writeln('<TEXTAREA NAME="',Fields[i].FieldName,'" ROWS=6 COLS=72>');
  93.               if not NewRec then
  94.                 writeln(Fields[i].AsString);
  95.               writeln('</TEXTAREA>')
  96.             end
  97.             else
  98.             begin
  99.               if Fields[i].Size > 99 then
  100.                 write('<INPUT TYPE=text NAME="',Fields[i].FieldName,'" SIZE=64')
  101.               else
  102.                 if Fields[i].Size = 0 then
  103.                   write('<INPUT TYPE=text NAME="',Fields[i].FieldName,'" SIZE=30')
  104.                 else
  105.                   write('<INPUT TYPE=text NAME="',Fields[i].FieldName,'" SIZE=',Fields[i].Size);
  106.               if not NewRec then
  107.                 write(' VALUE="',Fields[i].AsString,'"');
  108.               writeln('>')
  109.             end
  110.           end
  111.           else
  112.           begin
  113.             writeln('<SELECT NAME="',Fields[i].FieldName,'">');
  114.             for j:=1 to items do
  115.             begin
  116.               option := ReadString(Fields[i].FieldName,'Item'+Int[j],Int[j]);
  117.               if (not NewRec) and (option = Fields[i].AsString) then { selected }
  118.                 writeln('<OPTION SELECTED VALUE="',option,'">',option,' ')
  119.               else
  120.                 writeln('<OPTION VALUE="',option,'">',option,' ')
  121.             end;
  122.             writeln('</SELECT>')
  123.           end;
  124.           writeln('</TD>')
  125.         end;
  126.         writeln('</TR>')
  127.       finally
  128.         writeln('</TABLE>');
  129.         Free
  130.       end
  131.     end
  132.   end;
  133.  
  134. const
  135.   _DatabaseName = ''; { no alias: current directory }
  136.   _TableName = 'report.db';
  137.   Action: String[7] = '';
  138. var
  139.   Table: TTable;
  140.   Report,i: Integer; { key field }
  141.   NoChange: Boolean;
  142. begin
  143.   ShortDateFormat := 'DD/MM/YYYY';
  144.   ChDir('data');
  145.   if IOResult <> 0 then { skip };
  146.   writeln('content-type: text/html');
  147.   writeln;
  148.   writeln('<HTML>');
  149.   with TIniFile.Create(IniFile) do
  150.   try
  151.     writeln('<HEAD>');
  152.     writeln('<TITLE>',ReadString(_TableName,'Name',''),'</TITLE>');
  153.     writeln('</HEAD>');
  154.     writeln('<BODY BGCOLOR=AAAAAA>');
  155.     writeln('<CENTER>');
  156.     writeln('<H1>');
  157.     writeln('<IMG SRC="',ReadString(_TableName,'Bitmap',''),'">');
  158.     writeln(ReadString(_TableName,'Name',''));
  159.     writeln('</H1>');
  160.     writeln('<FORM METHOD=POST ACTION="',ReadString(_TableName,'Action',''),'">')
  161.   finally
  162.     Free
  163.   end;
  164.   Table := TTable.Create(nil);
  165.   with Table do
  166.   try
  167.     Active := False;
  168.     TableType := ttParadox;
  169.     DatabaseName := _DatabaseName;
  170.     TableName := _TableName;
  171.     Open;
  172.     { locate current record }
  173.     Report := ValueAsInteger('Report');
  174.     if Report > 0 then FindKey([Report])
  175.                   else First;
  176.     { update record if data has changed }
  177.     if (Value('_'+Fields[0].FieldName) <> '') and { old data is stored }
  178.        (ValueAsInteger(Fields[0].FieldName) <> -1) then
  179.     begin
  180.       NoChange := True; { assume no change }
  181.       for i:=0 to FieldCount-1 do
  182.         NoChange := NoChange AND
  183.          (Value('_'+Fields[i].FieldName) = Value(Fields[i].FieldName));
  184.       if not NoChange then { update record }
  185.       begin
  186.         { check if data in table is still the same }
  187.         NoChange := True;
  188.         for i:=0 to FieldCount-1 do
  189.           NoChange := NoChange AND
  190.            (Value('_'+Fields[i].FieldName) = Fields[i].AsString);
  191.         if not NoChange then { table changed!! }
  192.         begin
  193.           writeln('<B>Error: value of record changed before your update was made!</B>');
  194.           Action := 'Refresh' { force refresh }
  195.         end
  196.         else { go ahead! }
  197.         begin
  198.           writeln('<FONT SIZE=2>Note: ');
  199.           Edit; { set Table in Edit-mode }
  200.           for i:=0 to FieldCount-1 do
  201.           begin
  202.             if (Value('_'+Fields[i].FieldName) <> Value(Fields[i].FieldName)) then
  203.             begin
  204.             {$IFDEF DEBUG}
  205.               write(i,' [',Value('_'+Fields[i].FieldName),']-{',Value(Fields[i].FieldName),'} ');
  206.             {$ENDIF}
  207.               Fields[i].AsString := Value(Fields[i].FieldName) { new }
  208.             end
  209.           end;
  210.           Post { Post data in Table };
  211.           writeln(' previous record updated in table</FONT><P>')
  212.         end
  213.       end
  214.     end;
  215.     { determine action }
  216.     if Action = '' then
  217.       Action := Value('Action');
  218.     if Action = '' then Action := 'First';
  219.     { perform action }
  220.     if Action = 'First' then First
  221.     else
  222.     if Action = 'Next' then Next
  223.     else
  224.     if Action = 'Prev' then Prior
  225.     else
  226.     if Action = 'Last' then Last
  227.     else
  228.     if (Action = 'Find') or (Action = 'Query') then
  229.     begin
  230.       // TODO: special query CGI-Form
  231.     end
  232.     else
  233.     if Action = 'Delete' then Delete
  234.     else
  235.     if Action = 'Insert' then { skip }
  236.     else
  237.     if Action = 'Post' then { insert record }
  238.     begin
  239.       First;
  240.       Report := 0;
  241.       while not Eof do
  242.       begin
  243.         if Fields[0].AsInteger > Report then Report := Fields[0].AsInteger;
  244.         Next
  245.       end;
  246.       Inc(Report);
  247.       Insert;
  248.       Fields[0].AsInteger := Report;
  249.       for i:=1 to FieldCount-1 do
  250.         Fields[i].AsString := Value(Fields[i].FieldName);
  251.       Post;
  252.     end
  253.     else
  254.     if Action = 'Cancel' then { cancel }
  255.     else
  256.       { Refresh };
  257.     for i:=0 to FieldCount-1 do
  258.       writeln('<INPUT TYPE=HIDDEN NAME="_',Fields[i].FieldName,
  259.                                '" VALUE="',Fields[i].AsString,'">');
  260.     writeln(Fields[0].AsString,' - ',RecNo,'/',RecordCount,'  ');
  261.  
  262.     { generate HTML CGI-Form with fields }
  263.     DataSetTable(Table,Action = 'Insert');
  264.     Close
  265.   finally
  266.     writeln('</FORM>');
  267.     writeln('</BODY>');
  268.     writeln('</HTML>');
  269.     Free
  270.   end
  271. end.
  272.